home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Deutsche Edition 1
/
Deutsche Edition 1.iso
/
amok
/
031-040
/
amok39
/
rdt
/
rdt.mod
< prev
next >
Wrap
Text File
|
1993-11-04
|
24KB
|
701 lines
(*-------------------------------------------------------------------------
:Program. RDT.mod (* Replace Default Tool *)
:Author. Reinhard Geisler
:Address. Plockhorstweg 20, D-4178 Kevelaer 3
:Phone. 02832-80320
:Version. 0.3
:Date. 4 Mar 90
:Copyright. Public Domain - only non-commercial
:Language. MODULA-II
:Translator. M2Amiga V3.3d
:History. V0.1 First release - for beta testers only 20 Oct 89
:History. V0.2 Updated for M2Amiga V3.3d - not released 22 Dec 89
:History. V0.3 partly rewritten and new options added
:History. now my own checking on Ctrl-C
:History. also works with Workbench now
:History. first official release 4 Mar 90
:Contents. Replaces the Default-Tool in the Icon/.info file
:Remark. Thanks to Helmut Dalege for the idea
:Remark. Also credits for Jochen Kupfer and Peter Fischer for
:Remark. beta testing and suggestions
:Usage. RDT [DIR/File] [<OldToolname> <NewToolname>] [-l -s -i]
:Usage. -l : lists all filenames with toolnames
:Usage. -s : shows all avaiable toolnames
:Usage. -i : interactive - ? on input line for more help
-------------------------------------------------------------------------*)
MODULE RDT; (* Replace Default Tool *)
(* Programmaufruf: RDT Directory OldToolname NewToolname Optionen
Directory ist der Name des Directory, in dem die Default-Toolnamen
ersetzt werden sollen. Directory kann auch ein Devicename sein.
Es werden alle weiteren Sub-directories mit abgearbeitet.
OldToolname ist der alte Default-Toolname.
NewToolname ist der neue Default-Toolname.
z.B. RDT DF0: M2:m2emacs M2:DME
RDT DF0:Tools Utilities:More c:MuchMore
Als Optionen stehen -l, -s und -i zur Verfuegung
-l : list Es werden alle Filenamen und die Toolnamen
aufgefuehrt
-s : show Es wird jeder vorkommende Toolname einmal
aufgefuehrt
-i : interactive
Eingabeaufforderung bei jedem File an den User
? bei der Eingabe fuer weitere Hilfe
Hinweis: Bei der Eingabe von * oder #? fuer den OldToolname werden
alle Project-Icon-Files auf den NewToolname gesetzt!
"" als leerer Filename ist jetzt erlaubt!
*)
FROM SYSTEM IMPORT
ADR, ADDRESS, LONGSET;
FROM Arts IMPORT
wbStarted, Assert, CurrentLevel, DetectCtrlC, Terminate,
TermProcedure;
FROM Arguments IMPORT
GetArg, NumArgs;
FROM Dos IMPORT
ctrlC, sharedLock, FileLockPtr, Lock, UnLock,
FileInfoBlockPtr, Examine, ExNext;
FROM Exec IMPORT
SetSignal;
FROM Heap IMPORT
Allocate, Deallocate;
FROM Str IMPORT
CapString, Compare, Concat, Copy, Length;
FROM Strings IMPORT
last, Occurs;
FROM Terminal IMPORT
ReadLn, Write, WriteString, WriteLn;
FROM ASCII IMPORT
csi;
FROM Icon IMPORT
GetDiskObject, PutDiskObject, FreeDiskObject;
FROM Workbench IMPORT
WBObjectType, DiskObjectPtr;
CONST
copyright = " Replace-Default-Tool V0.3 (C) by Reinhard Geisler";
usage = " RDT [DIR/File] [<OldToolname> <NewToolname>] [-l -s -i]";
TYPE
String = ARRAY [0..127] OF CHAR;
LockListPtr = POINTER TO LockList;
LockList = RECORD
lock : FileLockPtr;
fib : FileInfoBlockPtr;
name : String;
next : LockListPtr;
END;
ReplaceListPtr = POINTER TO ReplaceList;
ReplaceList = RECORD
name : String;
next : ReplaceListPtr;
END;
ShowListPtr = POINTER TO ShowList;
ShowList = RECORD
name : String;
next : ShowListPtr;
END;
Work = (replace, list, show, interactive);
WorkSet = SET OF Work;
VAR
error : BOOLEAN;
errormessage, dirname,
oldToolname, newToolname : String;
lockListHeadPtr : LockListPtr;
replaceListHeadPtr : ReplaceListPtr;
showListHeadPtr : ShowListPtr;
eraseLine : ARRAY [0..3] OF CHAR;
icon : DiskObjectPtr; (* global for Cleanup *)
status : BOOLEAN; (* global for -r option *)
myWorkSet : WorkSet;
PROCEDURE CheckCtrlC;
BEGIN
IF (SetSignal(LONGSET{}, LONGSET{}) * LONGSET{ctrlC}) # LONGSET{} THEN
(* Ctrl-C pressed - abort *)
WriteLn; WriteLn;
WriteString("*** BREAK");
WriteLn;
Terminate(CurrentLevel());
END;
END CheckCtrlC;
PROCEDURE DeallocLockList;
VAR
deallocPtr : LockListPtr;
BEGIN
WHILE lockListHeadPtr # NIL DO
WITH lockListHeadPtr^ DO
IF fib # NIL THEN
Deallocate(fib);
END;
IF lock # NIL THEN
UnLock(lock);
END;
END; (* WITH *)
deallocPtr := lockListHeadPtr;
lockListHeadPtr := lockListHeadPtr^.next;
Deallocate(deallocPtr);
END; (* WHILE *)
END DeallocLockList;
PROCEDURE Cleanup();
VAR
deallocPtr : ADDRESS;
BEGIN
IF icon # NIL THEN
FreeDiskObject(icon);
END;
DeallocLockList;
WHILE replaceListHeadPtr # NIL DO
deallocPtr := replaceListHeadPtr;
replaceListHeadPtr := replaceListHeadPtr^.next;
Deallocate(deallocPtr);
END;
WHILE showListHeadPtr # NIL DO
deallocPtr := showListHeadPtr;
showListHeadPtr := showListHeadPtr^.next;
Deallocate(deallocPtr);
END;
WriteString(eraseLine);
Write(csi); WriteString(" p"); (* cursor on *)
WriteLn;
END Cleanup;
PROCEDURE GetArguments(VAR dir, old, new : String; VAR ws : WorkSet;
VAR err : BOOLEAN);
VAR
argumentnumber, dummylength : INTEGER;
argnumwithoutoptions : INTEGER;
dummystring : String;
i : INTEGER;
BEGIN
dir[0] := 0C; (* initialize *)
old[0] := 0C;
new[0] := 0C;
err := FALSE;
argnumwithoutoptions := 0;
argumentnumber := NumArgs();
IF wbStarted THEN
Write(csi); WriteString(" p"); (* cursor on *)
WriteString("DIR/File: ? ");
ReadLn(dir, dummylength);
IF dummylength = 0 THEN
dir := ""; (* current dir - where icon was located! *)
END;
WriteString("OldToolname: ? ");
ReadLn(old, dummylength);
IF dummylength # 0 THEN (* input of an old tool name *)
ws := WorkSet{replace};
WriteString("NewToolname: ? ");
ReadLn(new, dummylength);
IF dummylength = 0 THEN (* error no new toolname *)
err := TRUE;
END;
END;
IF NOT err THEN
WriteLn;
Write (csi); WriteString ("0;33;40m"); (* color 3 *)
WriteString("On the options enter Y or J for to do it - ");
WriteString("anything else not to do it!!!");
WriteLn;
Write(csi); WriteString ("0;31;40m"); (* normal textstyle *)
WriteString("Option interactive: ? ");
ReadLn(dummystring, dummylength);
IF ( (CAP(dummystring[0]) = "Y") OR
(CAP(dummystring[0]) = "J") )THEN
INCL(ws, interactive);
END;
WriteString("Option list: ? ");
ReadLn(dummystring, dummylength);
IF ( (CAP(dummystring[0]) = "Y") OR
(CAP(dummystring[0]) = "J") )THEN
INCL(ws, list);
ELSE
WriteString("Option show: ? ");
ReadLn(dummystring, dummylength);
IF ( (CAP(dummystring[0]) = "Y") OR
(CAP(dummystring[0]) = "J") )THEN
INCL(ws, show);
END;
END;
WriteLn;
END; (* IF not err *)
ELSIF (argumentnumber >= 1) AND (argumentnumber <=6) THEN
FOR i := 1 TO argumentnumber DO
GetArg(i, dummystring, dummylength);
CapString(dummystring);
IF Compare("-S", dummystring) = 0 THEN
INCL(ws, show);
ELSIF Compare("-L", dummystring) = 0 THEN
INCL(ws, list);
ELSIF Compare("-I", dummystring) = 0 THEN
ws := ws + WorkSet{interactive};
ELSIF dummystring[0] = "-" THEN
err := TRUE;
ELSE
INC(argnumwithoutoptions);
CASE argnumwithoutoptions OF
1 : GetArg(i, dir, dummylength); |
2 : GetArg(i, old, dummylength);
INCL(ws, replace)|
3 : GetArg(i, new, dummylength); |
4, 5 : err := TRUE;
END; (* CASE *)
END; (* IF *)
END; (* FOR *)
ELSE
err := TRUE;
END; (* IF wbStarted *)
IF NOT err THEN
IF (interactive IN ws) AND (NOT (replace IN ws)) THEN
EXCL(ws, interactive);
END;
IF ws = WorkSet{} THEN (* no option and wrong amount of args *)
err := TRUE;
ELSIF (WorkSet{show, list} <= ws) OR
(WorkSet{show, interactive} <= ws) THEN
EXCL(ws, show);
END;
IF (replace IN ws) THEN
IF NOT wbStarted THEN
IF argnumwithoutoptions = 2 THEN (* no dir/file as argument *)
new := old;
old := dir;
dir := ""; (* current dir *)
ELSIF argnumwithoutoptions # 3 THEN (* wrong amount of args *)
err := TRUE;
END; (* IF *)
END;
IF ( (old[0]="#") AND (old[1]="?") ) OR (old[0]="*") THEN
old[0] := "*";
old[1] := 0C;
IF ( NOT (interactive IN ws) ) THEN
WriteString("Are you sure, that you want to put ");
Write (csi); WriteString ("0;33;40m"); (* color 3 *)
WriteString("everything");
Write(csi); WriteString ("0;31;40m"); (* normal textstyle *)
WriteString(" to the"); WriteLn;
WriteString(" new Default-Tool-Name ? ");
Write(csi); WriteString(" p"); (* cursor on *)
ReadLn(dummystring, dummylength);
Write(csi); WriteString("0 p"); (* cursor off *)
IF NOT ( (CAP(dummystring[0]) = "Y") OR
(CAP(dummystring[0]) = "J") )THEN
WriteLn;
WriteString("*** QUIT");
WriteLn;
Terminate(CurrentLevel()); (* Quit program *)
END;
END; (* IF ( NOT (interactive *)
ELSIF ( (old[0]='"') AND (old[1]='"') ) THEN
old[0] := 0C; (* old default is empty *)
END; (* IF ( (old[0] *)
IF ( (new[0]='"') AND (new[1]='"') ) THEN
new[0] := 0C; (* new default is empty *)
END;
END; (* IF (replace *)
END; (* IF NOT err *)
END GetArguments;
PROCEDURE ReplaceTool;
VAR
deallocPtr : ReplaceListPtr;
strPtr : POINTER TO String;
BEGIN
icon := NIL; (* initialize *)
WriteString(eraseLine);
WriteLn;
WriteString("Replacing..."); WriteLn;
WHILE replaceListHeadPtr # NIL DO
CheckCtrlC; (* check for CtrlC *)
icon := GetDiskObject(ADR(replaceListHeadPtr^.name));
IF (icon # NIL) THEN
WriteString(replaceListHeadPtr^.name);
WriteString(".info: ");
Write (csi); WriteString ("0;32;40m"); (* color 2 *)
strPtr := icon^.defaultTool;
IF (strPtr^[0] = 0C) THEN
WriteString('""');
ELSE
WriteString(strPtr^);
END;
Write (csi); WriteString ("0;33;40m"); (* color 3 *)
icon^.defaultTool := ADR(newToolname);
IF PutDiskObject(ADR(replaceListHeadPtr^.name), icon) = FALSE THEN
WriteString(" not replaced - Disk-error!!");
ELSE
WriteString(" replaced!");
END;
FreeDiskObject(icon);
icon := NIL;
Write(csi); WriteString ("0;31;40m"); (* normal textstyle *)
WriteLn;
END;
deallocPtr := replaceListHeadPtr;
replaceListHeadPtr := replaceListHeadPtr^.next;
Deallocate(deallocPtr);
END;
END ReplaceTool;
PROCEDURE CheckFile(myLockList : LockListPtr; dir : BOOLEAN) : BOOLEAN;
(* dir = TRUE ; start from CheckDir - check directory
dir = FALSE ; start from main program - check single file
*)
VAR
dummy, pathname,
comparestring : String;
strPtr : POINTER TO String;
pos : INTEGER;
pathLength : CARDINAL;
newReplaceListPtr : ReplaceListPtr;
currentShowListPtr : ShowListPtr;
found : BOOLEAN;
inputstring : String;
dummylength : INTEGER;
doReplace : BOOLEAN;
noInput : BOOLEAN;
PROCEDURE ShowFile;
BEGIN
WriteString(eraseLine);
WriteString(pathname);
WriteString(".info: ");
Write (csi); WriteString ("0;32;40m"); (* color 2 *)
IF (strPtr^[0] = 0C) THEN
WriteString('""');
ELSE
WriteString(strPtr^);
END;
Write(csi); WriteString ("0;31;40m"); (* normal textstyle *)
END ShowFile;
BEGIN
icon := NIL; (* initialize *)
noInput := TRUE;
CheckCtrlC; (* check for CtrlC *)
Copy(dummy, myLockList^.fib^.fileName);
pos := Occurs(dummy, 0, ".info", FALSE);
IF (pos # last) AND (CARDINAL(pos) = Length(dummy)-5) AND (pos # 0) THEN
Copy(pathname, myLockList^.name);
pathLength := Length(pathname);
IF (pathLength > 0) AND (pathname[pathLength-1] # ":") THEN
pathname[pathLength] := "/";
pathname[pathLength + 1] := 0C;
END;
IF dir THEN
dummy[Length(dummy) - 5] := 0C;
Concat(pathname, dummy);
ELSE
pathname := myLockList^.name;
pathname[Length(pathname) - 5] := 0C;
END;
icon := GetDiskObject(ADR(pathname));
IF icon # NIL THEN
strPtr := icon^.defaultTool;
IF (icon^.type = project) THEN
comparestring := strPtr^;
CapString(comparestring);
IF (replace IN myWorkSet) THEN
IF ( Compare(comparestring, oldToolname) = 0 ) OR
(oldToolname[0] = "*") THEN
doReplace := TRUE;
IF interactive IN myWorkSet THEN
REPEAT
ShowFile;
WriteString(" ? ");
Write(csi); WriteString(" p"); (* cursor on *)
noInput := FALSE;
ReadLn(inputstring, dummylength);
Write(csi); WriteString("0 p"); (* cursor off *)
WriteString(eraseLine);
IF (inputstring[0] = "?") THEN
Write (csi); WriteString ("0;33;40m"); (* color 3 *)
WriteString("y/j=Yes / q=Quit / r=Replace now");
WriteString(" / anything else=no action!");
Write(csi);
WriteString ("0;31;40m"); (* normal textstyle *)
Write(csi); WriteString("F"); (* cursor up *)
END;
UNTIL (inputstring[0] # "?");
IF ( CAP(inputstring[0]) = "Q" ) THEN
FreeDiskObject(icon);
icon := NIL;
WriteLn;
WriteString("*** QUIT");
WriteLn;
Terminate(CurrentLevel()); (* Quit program *)
ELSIF ( CAP(inputstring[0]) = "R" ) THEN
RETURN FALSE; (* replace now *)
ELSE
doReplace := ( CAP(inputstring[0]) = "Y" ) OR
( CAP(inputstring[0]) = "J" );
END;
WriteString(myLockList^.name);
END;
IF doReplace THEN
Allocate(newReplaceListPtr, SIZE(newReplaceListPtr^));
Assert(newReplaceListPtr # NIL, ADR("Out of Memory!"));
newReplaceListPtr^.next := replaceListHeadPtr;
replaceListHeadPtr := newReplaceListPtr;
replaceListHeadPtr^.name := pathname;
END;
END; (* IF *)
END; (* IF *)
IF (list IN myWorkSet) AND noInput THEN
ShowFile;
WriteLn;
WriteString(myLockList^.name);
END;
IF show IN myWorkSet THEN
IF (comparestring[0] = 0C) THEN
comparestring := '""';
END;
currentShowListPtr := showListHeadPtr;
found := FALSE;
WHILE (currentShowListPtr # NIL) AND (NOT found) DO
IF Compare(comparestring, currentShowListPtr^.name) = 0 THEN
found := TRUE;
ELSE
currentShowListPtr := currentShowListPtr^.next;
END; (* IF *)
END; (* WHILE *)
IF NOT found THEN
Allocate(currentShowListPtr, SIZE(currentShowListPtr^));
Assert(currentShowListPtr # NIL, ADR("Out of Memory!"));
currentShowListPtr^.next := showListHeadPtr;
showListHeadPtr := currentShowListPtr;
showListHeadPtr^.name := comparestring;
WriteString(eraseLine);
Write (csi); WriteString ("0;33;40m"); (* color 3 *)
WriteString("Found: ");
Write(csi); WriteString ("0;31;40m"); (* normal textstyle *)
IF (strPtr^[0] = 0C) THEN
WriteString('""');
ELSE
WriteString(strPtr^);
END;
WriteLn;
WriteString(myLockList^.name);
END; (* IF NOT found *)
END; (* IF *)
END; (* IF (strPtr[0] *)
FreeDiskObject(icon);
icon := NIL;
END; (* IF icon # NIL *)
END; (* IF (pos # last) *)
RETURN TRUE;
END CheckFile;
PROCEDURE CheckDir(myLockList : LockListPtr);
VAR
OK : BOOLEAN;
path : String;
pathLength : CARDINAL;
BEGIN
WriteString(eraseLine);
WriteString(myLockList^.name);
REPEAT
CheckCtrlC; (* check for CtrlC *)
OK := ExNext(myLockList^.lock, myLockList^.fib) AND status;
IF OK AND (myLockList^.fib^.dirEntryType > 0) THEN
Copy(path, myLockList^.name);
pathLength := Length(path);
IF (pathLength > 0) AND (path[pathLength-1] # ":") THEN
path[pathLength] := "/";
path[pathLength + 1] := 0C;
END;
Concat(path, myLockList^.fib^.fileName);
Allocate(myLockList^.next, SIZE(LockList));
Assert(myLockList^.next # NIL, ADR("Out of Memory!"));
WITH myLockList^.next^ DO
next := NIL;
name := path;
lock := Lock(ADR(path), sharedLock);
Assert(lock # NIL, ADR("Error: Lock!"));
Allocate(fib, SIZE(fib^));
Assert(fib # NIL, ADR("Out of Memory!"));
OK := Examine(lock, fib);
Assert(OK, ADR("Error: Examine!"));
END; (* WITH *)
CheckDir(myLockList^.next);
WITH myLockList^.next^ DO
IF fib # NIL THEN
Deallocate(fib);
END;
IF lock # NIL THEN
UnLock(lock);
END;
END; (* WITH *)
Deallocate(myLockList^.next);
myLockList^.next := NIL;
ELSIF OK AND (myLockList^.fib^.dirEntryType < 0) THEN
status := CheckFile(myLockList, TRUE);
OK := status;
END;
UNTIL NOT OK;
END CheckDir;
BEGIN (* RDT *)
(* initialize *)
lockListHeadPtr := NIL;
replaceListHeadPtr := NIL;
showListHeadPtr := NIL;
TermProcedure(Cleanup);
DetectCtrlC(FALSE);
myWorkSet := WorkSet{};
error := FALSE;
status := TRUE;
eraseLine[0] := 15C;
eraseLine[1] := csi;
eraseLine[2] := "K";
eraseLine[3] := 0C;
Write(csi); WriteString("0 p"); (* cursor off *)
WriteLn;
Write (csi); WriteString ("0;33;40m"); (* color 3 *)
WriteString(copyright);
Write(csi); WriteString ("0;31;40m"); (* normal textstyle *)
WriteLn; WriteLn;
GetArguments(dirname, oldToolname, newToolname, myWorkSet, error);
IF NOT error THEN
WriteString("In ");
Write (csi); WriteString ("0;33;40m"); (* color 3 *)
IF dirname[0] = 0C THEN
WriteString("currentdir");
ELSE
WriteString(dirname);
END;
Write(csi); WriteString ("0;31;40m"); (* normal textstyle *)
IF replace IN myWorkSet THEN
WriteString(" replace name ");
Write (csi); WriteString ("0;33;40m"); (* color 3 *)
WriteString(oldToolname);
Write(csi); WriteString ("0;31;40m"); (* normal textstyle *)
WriteString(" with ");
Write (csi); WriteString ("0;33;40m"); (* color 3 *)
WriteString(newToolname);
Write(csi); WriteString ("0;31;40m"); (* normal textstyle *)
END;
IF (list IN myWorkSet) OR (show IN myWorkSet)
OR (interactive IN myWorkSet) THEN
WriteLn;
WriteString(" Option: ");
Write (csi); WriteString ("0;33;40m"); (* color 3 *)
IF (list IN myWorkSet) THEN
WriteString("list! ");
ELSIF (show IN myWorkSet) THEN
WriteString("show! ");
END;
IF (interactive IN myWorkSet) THEN
WriteString("interactive!");
END;
Write(csi); WriteString ("0;31;40m"); (* normal textstyle *)
END; (* IF (list *)
WriteLn; WriteLn;
CapString(oldToolname);
Allocate(lockListHeadPtr, SIZE(lockListHeadPtr^));
Assert(lockListHeadPtr # NIL, ADR("Out of Memory!"));
lockListHeadPtr^.name := dirname;
lockListHeadPtr^.lock := Lock(ADR(lockListHeadPtr^.name), sharedLock);
IF lockListHeadPtr^.lock # NIL THEN (* received lock *)
Allocate(lockListHeadPtr^.fib, SIZE(lockListHeadPtr^.fib^));
IF (lockListHeadPtr^.fib # NIL) AND
Examine(lockListHeadPtr^.lock, lockListHeadPtr^.fib) THEN
IF (lockListHeadPtr^.fib^.dirEntryType > 0) THEN (* directory *)
WriteString("Searching...."); WriteLn;
CheckDir(lockListHeadPtr);
ELSE (* file *)
status := CheckFile(lockListHeadPtr, FALSE);
END; (* IF *)
DeallocLockList;
IF (replace IN myWorkSet) AND (replaceListHeadPtr # NIL) THEN
ReplaceTool;
ELSIF (replace IN myWorkSet) THEN
WriteString(eraseLine);
WriteLn;
Write (csi); WriteString ("0;33;40m"); (* color 3 *)
WriteString("Nothing found to replace!");
Write(csi); WriteString ("0;31;40m"); (* normal textstyle *)
WriteLn;
END;
END; (* IF *)
ELSE (* no lock! *)
Write (csi); WriteString ("0;33;40m"); (* color 3 *)
WriteString("Error: Couldn't get directory !");
Write(csi); WriteString ("0;31;40m"); (* normal textstyle *)
WriteLn;
END;
ELSE (* error!!! *)
WriteString(usage);
WriteLn; WriteLn;
WriteString(" Replaces the default-icon in the icon-/.info file!");
WriteLn;
WriteString(" -l : lists all filenames with toolnames");
WriteLn;
WriteString(" -s : shows all available toolnames");
WriteLn;
WriteString(" -i : interactive - ? on input line for more help");
WriteLn;
WriteString(" * or #? for the OldToolname puts everything to");
WriteString(" the NewToolname!");
IF NOT wbStarted THEN
WriteLn; WriteLn;
WriteString(" e.g.: RDT df0: -l"); WriteLn;
WriteString(" RDT df0: c:More c:MuchMore -s"); WriteLn;
WriteString(" RDT df1: c:* c:less -l");
END;
WriteLn;
END;
END RDT.